home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / gui140.zip / GUI140.BAS < prev    next >
Encoding:
BASIC Source File  |  1997-06-28  |  7.4 KB  |  310 lines
  1. 'GUI140.BAS
  2. 'GUI Library v. 1.40
  3. 'for QuickBasic 4.5
  4. 'Copyright (c) 1995 - 1997 by Tika Carr
  5. '
  6. 'Special Instructions:
  7. '
  8. 'Load QuickBasic from DOS:
  9. 'qb /ah /l qb.qlb
  10. '
  11. 'See Documentation GUI.DOC for instructions on what to do with this file.
  12.  
  13.  
  14. '$INCLUDE: 'gui.bi'
  15. '$DYNAMIC
  16.  
  17. FUNCTION button$ (x%, y%, t$, bc%, tc%, hl%, cp%, flag%)
  18.  
  19. mouse "hide"
  20.  
  21. DIM h$(1 TO 4)
  22. a = x% + LEN(t$) * 8 + 14: B = y% + 18
  23. h$(1) = HEX$(x%): h$(2) = HEX$(y%): h$(3) = HEX$(a): h$(4) = HEX$(B)
  24. IF cp% < 1 THEN cp% = 1
  25.  
  26. IF flag% = 1 THEN drwbtn 2, bc%, 0, 0, x%, y%, a, B
  27. x% = x% + 8: IF cp% > 1 THEN x% = x% + 2
  28. y% = y% + 2
  29. gprint LEFT$(t$, cp% - 1), x% - 2, y%, tc%
  30. x% = x% + (cp% - 1) * 8
  31. gprint MID$(t$, cp%, 1), x%, y%, hl%
  32. gprint RIGHT$(t$, LEN(t$) - cp%), x% + 8, y%, tc%
  33.  
  34. mouse "show"
  35.  
  36. 'calculate return value string
  37. FOR i = 1 TO 4
  38.     IF LEN(h$(i)) < 2 THEN temp$ = temp$ + "0"
  39.     IF LEN(h$(i)) < 3 THEN temp$ = temp$ + "0"
  40.     temp$ = temp$ + h$(i)
  41. NEXT
  42. IF flag% THEN temp$ = temp$ + "1" ELSE temp$ = temp$ + "0" 'button or not
  43. button$ = temp$
  44.  
  45. END FUNCTION
  46.  
  47. SUB clrscrn (clr%)
  48.  
  49. mouse "hide"
  50. LINE (0, 0)-(639, 479), clr%, BF
  51. mouse "show"
  52.  
  53. END SUB
  54.  
  55. SUB drwbtn (ds, dc, dfs, dfc, dx1, dy1, dx2, dy2)
  56.  
  57. 'Add new style: "Plain" Window (plain with colored non-3d border)
  58.  
  59. mouse "hide"
  60.  
  61. IF ds >= 3 AND ds <= 6 THEN c = dfc ELSE c = dc
  62. IF ds < 9 THEN LINE (dx1, dy1)-(dx2, dy2), white%, BF
  63. IF ds > 8 THEN
  64.     CIRCLE (dx1, dy1), dfs, white%
  65.     PAINT (dx1, dy1), white%, white%
  66. END IF
  67.  
  68. SELECT CASE ds
  69.     CASE 1: GOSUB dOn
  70.     CASE 2: GOSUB dOff
  71.     CASE 3: GOSUB dOn: GOSUB Inside: GOSUB dOff
  72.     CASE 4: GOSUB dOff: GOSUB Inside: GOSUB dOn
  73.     CASE 5: GOSUB dOn: GOSUB Inside: GOSUB dOn
  74.     CASE 6: GOSUB dOff: GOSUB Inside: GOSUB dOff
  75.     CASE 7: GOSUB Dsqu
  76.     CASE 8:
  77.         GOSUB Dsqu: LINE (dx1, dy1)-(dx2, dy2), black%: LINE (dx1, dy2)-(dx2, dy1), black%
  78.     CASE 9: GOSUB Dcir
  79.     CASE 10: GOSUB Dcir: CIRCLE (dx1, dy1), (15 - dfs) \ 2, dfc: PAINT (dx1, dy1), dfc, dfc
  80. END SELECT
  81.  
  82. GOTO Ddone
  83.  
  84. Dsqu:
  85.     LINE (dx1, dy1)-(dx2, dy2), black%, B: PAINT (dx2 - 4, dy2 - 4), c, black%
  86. RETURN
  87.  
  88. DBold:
  89.     GOSUB Dsqu: LINE (dx1 + 1, dy1 + 1)-(dx2 - 1, dy2 - 1), black%, B
  90. RETURN
  91.  
  92. dOn:
  93.     GOSUB DBold: LINE (dx1 + 1, dy2 - 1)-(dx2 - 1, dy2 - 1), white%
  94.     LINE -(dx2 - 1, dy1 + 1), white%
  95. RETURN
  96.  
  97. dOff:
  98.     GOSUB DBold: LINE (dx1 + 1, dy2 - 1)-(dx1 + 1, dy1 + 1), white%
  99.     LINE -(dx2 - 1, dy1 + 1), white%
  100. RETURN
  101.  
  102. Dcir:
  103.     CIRCLE (dx1, dy1), dfs, black%: PAINT (dx1, dy1), dc, black%
  104. RETURN
  105.  
  106. Inside:
  107.     dx1 = dx1 + dfs: dy1 = dy1 + dfs: dx2 = dx2 - dfs: dy2 = dy2 - dfs: c = dc
  108. RETURN
  109.  
  110. Ddone: dx1 = dx1 - dfs: dy1 = dy1 - dfs: dx2 = dx2 + dfs: dy2 = dy2 + dfs
  111.  
  112. mouse "show"
  113.  
  114. END SUB
  115.  
  116. SUB gprint (z$, x%, y%, c%)
  117.  
  118. 'This routine was written by Douglas Lusher
  119.  
  120. mouse "hide"
  121.  
  122. Regs.ax = &H1130: Regs.bx = &H600: CALL INTERRUPTX(&H10, Regs, Regs)
  123.  
  124. CharSegment% = Regs.es: CharOffset% = Regs.bp: CharWid% = 8: CharHgt% = 16
  125.  
  126. DEF SEG = CharSegment%: XX% = x
  127.  
  128. FOR Char% = 1 TO LEN(z$)
  129.     Ptr% = CharHgt% * ASC(MID$(z$, Char%, 1)) + CharOffset%
  130.     FOR Ln% = 0 TO CharHgt% - 1
  131.         BitPattern& = PEEK(Ptr% + Ln%) * 256&
  132.         LineFormat% = (BitPattern& - 32768) XOR -32768
  133.         LINE (XX%, y + Ln%)-STEP(CharWid% - 1, 0), c, , LineFormat%
  134.     NEXT
  135.     XX% = XX% + CharWid%
  136. NEXT
  137.  
  138. DEF SEG
  139.  
  140. mouse "show"
  141.  
  142. END SUB
  143.  
  144. SUB ImgBuff (x1%, y1%, x2%, y2%, flag%) STATIC
  145.  
  146. mouse "hide"
  147.  
  148. '** Save Buffer code
  149.  
  150. IF flag% = 0 THEN
  151.     'Calculate array
  152.     Array% = 4 + INT(((x2% - x1% + 1) * 1 + 7) / 8) * 4 * ((y2% - y1%) + 1)
  153.  
  154.     'Check for array size too large and end program if out of bounds
  155.     IF Array% > 32767 OR Array% < 0 THEN ERROR 1
  156.     REDIM ImBuf(1 TO Array%)
  157.     GET (x1%, y1%)-(x2%, y2%), ImBuf
  158.  
  159. END IF
  160.  
  161. '** Load buffer code
  162.  
  163. IF flag% = 1 THEN PUT (x1%, y1%), ImBuf, PSET    'Illegal Function Call here
  164.  
  165. mouse "show"
  166.  
  167. END SUB
  168.  
  169. SUB mouse (a$)
  170.  
  171. a$ = LCASE$(a$)
  172.  
  173. SELECT CASE a$
  174.     CASE "init": Inregs.ax = 0
  175.     CASE "show": Inregs.ax = 1
  176.     CASE "hide": Inregs.ax = 2
  177.     CASE "get": Inregs.ax = 3
  178.     CASE ELSE: Inregs.ax = 0
  179. END SELECT
  180.  
  181. INTERRUPT &H33, Inregs, Outregs
  182.  
  183. mb = Outregs.bx     'button 0 = off 1 = left 2 = right
  184. mx = Outregs.cx     'x coordinate
  185. my = Outregs.dx     'y coordinate
  186.  
  187. END SUB
  188.  
  189. FUNCTION PopInp$ (p$, l%, x%, y%, bc%, tc%, fc%, ft%, cc%)
  190.  
  191. c$ = CHR$(219): t$ = ""                         'Set cursor and temp variable
  192.  
  193. '** Draw box and print prompt
  194. IF LEN(p$) > l% THEN x2 = x% + (LEN(p$) + 2) * 8 ELSE x2 = x% + (l% + 2) * 8
  195. a = x%: B = y%
  196. ImgBuff x%, y%, x2, y% + 64, 0   'Save screen under box
  197. drwbtn 2, bc%, 0, 0, x%, y%, x2, y% + 64
  198. x% = x% + 8: gprint p$, x%, y% + 8, tc%
  199.  
  200. '** Set up input field
  201. y% = y% + 32                                    'Move down to input line
  202. gprint ">", x%, y%, tc%: x% = x% + 8
  203. gprint STRING$(l%, 219), x%, y%, fc%            'Input Field
  204. gprint c$, x%, y%, cc%                          'Cursor
  205.  
  206. '** Process input
  207. DO
  208.     e$ = INPUT$(1): d = ASC(e$)
  209.     IF d = 13 THEN EXIT DO
  210.     '** check for valid characters & within field
  211.     IF d < 128 AND d > 32 AND LEN(t$) < l% THEN
  212.         t$ = t$ + e$                                'add character
  213.         gprint c$, x%, y%, fc%                      'erase cursor
  214.         gprint e$, x%, y%, ft%                      'print character
  215.         x% = x% + 8: gprint c$, x%, y%, cc%         'print cursor
  216.     ELSEIF d = 8 AND LEN(t$) > 0 THEN             'backspace pressed
  217.         t$ = RIGHT$(t$, LEN(t$) - 1): x% = x% - 8   'remove character from input
  218.         gprint CHR$(219), x%, y%, fc%               'erase character
  219.         gprint CHR$(219), x% + 8, y%, bc%           'erase cursor
  220.         gprint c$, x%, y%, cc%                      'place cursor
  221.     END IF
  222. LOOP
  223.  
  224. '** Replace screen (popup done), show mouse and return input
  225. ImgBuff a, B, 0, 0, 1
  226. PopInp$ = t$
  227.  
  228. END FUNCTION
  229.  
  230. SUB PopUpBox (x, y, clrbox, clrbdr, clrtext, TextArray$())
  231.  
  232. NumLines = UBOUND(TextArray$)    'Get # of lines
  233. y2 = NumLines * 8 + 16           'Calculate the maximum Y value
  234.  
  235. 'Look at TextArray and get maximum X value
  236. Tmp1 = 0: Tmp2 = 0
  237. FOR i = 1 TO NumLines
  238.     Tmp1 = LEN(TextArray$(i)): IF Tmp1 > Tmp2 THEN x2 = Tmp1
  239.     Tmp2 = Tmp1
  240. NEXT
  241.  
  242. x1 = x: y1 = y: x2 = x1 + x2 * 8 + 40: y2 = y1 + y2 + NumLines * 8 + 32
  243. 'x2 above fixes "end of line" bug - hopefully
  244. 'y2 allows for more space between text and button
  245.  
  246. ImgBuff x1, y1, x2, y2, 0  'Save screen underneath
  247.  
  248. 'Draw the box
  249. drwbtn 4, clrbox, 4, clrbdr, x1, y1, x2, y2
  250. tx = x1 + 16: ty = y1 + 8
  251.  
  252. 'Insert Text
  253. FOR i = 1 TO NumLines
  254.     gprint TextArray$(i), tx, ty, clrtext: ty = ty + 16
  255. NEXT
  256.  
  257. 'button$ (x%, y%, t$, bc%, tc%, hl%, cp%)
  258. PopOk$ = button$(x1 + ((x2 - x1) \ 2) - 16, ty + 12, "OK", 7, black%, black%, 0, 1)
  259. DO
  260.     mouse "get"
  261.     IF mb = 1 THEN
  262.         OK = pushbtn%(PopOk$)
  263.         IF OK = 1 THEN OK = 0: EXIT DO
  264.     END IF
  265. LOOP
  266.  
  267. 'Restore Screen
  268. ImgBuff x1, y1, 0, 0, 1
  269.  
  270. END SUB
  271.  
  272. FUNCTION pushbtn% (byte$)
  273.  
  274. '** get values and adjust
  275. x = VAL("&H" + LEFT$(byte$, 3)) + 1
  276. y = VAL("&H" + MID$(byte$, 4, 3)) + 1
  277. a = VAL("&H" + MID$(byte$, 7, 3)) - 1
  278. B = VAL("&H" + MID$(byte$, 10, 3)) - 1
  279. pb = VAL("&H" + MID$(byte$, 13, 1))
  280.  
  281. IF mx < x OR mx > a OR my < y OR my > B THEN
  282.     pushbtn% = 0
  283.     EXIT FUNCTION
  284. END IF
  285.  
  286. '** If its a button, push it
  287. IF pb THEN
  288.     mouse "hide"
  289.     LINE (x, y)-(a, B), black%, B
  290.     LINE (x, B)-(a, B), white%
  291.     LINE -(a, y), white%
  292.     FOR delay& = 1 TO 32000: NEXT
  293.     LINE (x, y)-(a, B), white%, B
  294.     LINE (x, B)-(a, B), black%
  295.     LINE -(a, y), black%
  296.     mouse "show"
  297. END IF
  298.  
  299. pushbtn% = 1
  300.  
  301. END FUNCTION
  302.  
  303. SUB TitleBar (t$, bc%, tc%)
  304.  
  305. drwbtn 2, bc%, 0, 0, 0, 0, 639, 24
  306. gprint t$, (40 - LEN(t$) \ 2) * 8, 5, tc%
  307.  
  308. END SUB
  309.  
  310.